home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / llist10.zip / DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-14  |  3KB  |  148 lines
  1. PROGRAM demo;
  2.  
  3. {This program gives a short demonstration of the llist unit.  It creates
  4. a list of people, keeping the name and age of each person, and then
  5. searches the list, deleting all people whose age falls within a specified
  6. range.  It then displays the remaining people, and finally gets rid of
  7. all the people.}
  8.  
  9.  
  10. USES
  11.   llist;
  12.  
  13.  
  14. TYPE
  15.   person_ptr = ^person;
  16.   person =
  17.     OBJECT (linked_list_node)
  18.     my_name: String;
  19.     my_age : Byte;
  20.     CONSTRUCTOR init (name: String; age: Byte);
  21.     PROCEDURE show;
  22.     FUNCTION get_age: Byte;
  23.     END;
  24.  
  25.  
  26. {----- Methods for person -----}
  27.  
  28. CONSTRUCTOR person.init (name: String; age: Byte);
  29. BEGIN
  30.   linked_list_node.init;
  31.   my_name := name;
  32.   my_age  := age
  33. END;
  34.  
  35.  
  36. PROCEDURE person.show;
  37. BEGIN
  38.   Writeln ('Age: ', my_age:3, '  Name: ', my_name)
  39. END;
  40.  
  41.  
  42. FUNCTION person.get_age: Byte;
  43. BEGIN
  44.   get_age := my_age
  45. END;
  46.  
  47.  
  48. {----- The rest of the program -----}
  49.  
  50.  
  51. VAR
  52.   person_list: linked_list_anchor;
  53.  
  54.  
  55. PROCEDURE create_person_and_add_to_list (name: String; age: Byte);
  56. VAR
  57.   p: person_ptr;
  58. BEGIN
  59.   New (p, init (name, age) );
  60.   person_list.add_to_tail (p^);
  61.   p^.show
  62. END;
  63.  
  64.  
  65. PROCEDURE show_age_range (low, high: Byte);
  66. VAR
  67.   p  : person_ptr;
  68.   age: Byte;
  69. BEGIN
  70.   p := person_ptr (person_list.get_first);
  71.   WHILE (p <> NIL) DO
  72.     BEGIN
  73.     age := p^.get_age;
  74.     IF (age >= low) AND (age <= high) THEN
  75.       p^.show;
  76.     p := person_ptr (p^.get_next)
  77.     END
  78. END;
  79.  
  80.  
  81. PROCEDURE show_all_people;
  82. VAR
  83.   p  : person_ptr;
  84.   age: Byte;
  85. BEGIN
  86.   Writeln ('Showing all people:');
  87.   IF person_list.empty THEN
  88.     Writeln ('No people to show!')
  89.   ELSE
  90.     BEGIN
  91.     p := person_ptr (person_list.get_first);
  92.     WHILE (p <> NIL) DO
  93.       BEGIN
  94.       p^.show;
  95.       p := person_ptr (p^.get_next)
  96.       END
  97.     END
  98. END;
  99.  
  100.  
  101. PROCEDURE delete_all_people_between_ages (low, high: Byte);
  102. VAR
  103.   p   : person_ptr;
  104.   next: person_ptr;
  105.   age : Byte;
  106. BEGIN
  107.   Writeln ('Deleting all people between ages ', low, ' and ', high, ':');
  108.   p := person_ptr (person_list.get_first);
  109.   WHILE (p <> NIL) DO
  110.     BEGIN
  111.     next := person_ptr (p^.next);
  112.     age := p^.get_age;
  113.     IF (age >= low) AND (age <= high) THEN
  114.       BEGIN
  115.       p^.show;
  116.       Dispose (p, done)
  117.       END;
  118.     p := next
  119.     END
  120. END;
  121.  
  122.  
  123. BEGIN
  124.   Writeln ('Started out with ', MaxAvail, ' bytes of free heap');
  125.   Writeln;
  126.   person_list.init;
  127.   Writeln ('Creating people:');
  128.   create_person_and_add_to_list ('Susan'    , 25);
  129.   create_person_and_add_to_list ('John'     , 20);
  130.   create_person_and_add_to_list ('Elizabeth', 65);
  131.   create_person_and_add_to_list ('Chell'    , 25);
  132.   create_person_and_add_to_list ('Martan'   , 19);
  133.   create_person_and_add_to_list ('Ann'      , 48);
  134.   create_person_and_add_to_list ('Brett'    , 17);
  135.   create_person_and_add_to_list ('William'  , 27);
  136.   Writeln;
  137.   delete_all_people_between_ages (20, 30);
  138.   Writeln;
  139.   show_all_people;
  140.   Writeln;
  141.   Writeln ('Disposing all people');
  142.   person_list.dispose_all_nodes;
  143.   Writeln;
  144.   show_all_people;
  145.   Writeln;
  146.   Writeln ('Ended up with ', MaxAvail, ' bytes of free heap')
  147. END.
  148.